home *** CD-ROM | disk | FTP | other *** search
/ Skunkware 98 / Skunkware 98.iso / src / interp / tclStruct1.2.tar.gz / tclStruct1.2.tar / tclStruct1.2 / stObject.c < prev    next >
C/C++ Source or Header  |  1995-09-12  |  6KB  |  224 lines
  1. /*
  2.  *    tclStruct package
  3.  *  Support 'C' structures in Tcl
  4.  *
  5.  *  Written by Matthew Costello
  6.  *  (c) 1995 AT&T Global Information Solutions, Dayton Ohio USA
  7.  *
  8.  *  See the file "license.terms" for information on usage and
  9.  *  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  10.  */
  11. #include "stInternal.h"
  12. STRUCT_SCCSID("@(#)tclStruct:stObject.c    1.1    95/09/08")
  13.  
  14. /*
  15.  * generate uniq Id
  16.  */
  17. CONST char *
  18. Struct_GenerateName(base)
  19.   CONST char *base;
  20. {
  21.     static int id=1;
  22.     static char name[16];
  23.     sprintf(name,"%.10s%d",base,id++);
  24.     return name;
  25. }
  26.  
  27. #ifdef DEBUG
  28. CONST char *
  29. Struct_ObjectName(object,inclobjaddr)
  30.   Struct_Object *object;
  31.   int inclobjaddr;
  32. {
  33.     static char namebuf[128];
  34.     if (inclobjaddr)
  35.       sprintf(namebuf,"%p[%s,%p/%ld,%d]",
  36.     (void *)object,
  37.     Struct_TypeName(object->type),
  38.     object->data,
  39.     (long) object->data,
  40.     object->size );
  41.     else
  42.       sprintf(namebuf,"[%s,%p/%ld,%d]",
  43.     Struct_TypeName(object->type),
  44.     object->data,
  45.     (long)object->data,
  46.     object->size );
  47.     return namebuf;
  48. }
  49. #endif
  50.  
  51. /*
  52.  * Struct_NewObject : creates a new binary object
  53.  *   if the dataptr argument is NULL, allocate the data part too
  54.  *   if the size is 0, then use the size of the type
  55.  */
  56. Struct_Object *
  57. Struct_NewObject(type,dataptr,size)
  58.   Struct_TypeDef *type;
  59.   void *dataptr;
  60.   int size;
  61. {
  62.     int len;
  63.     Struct_Object *object;
  64.  
  65. #ifdef DEBUG
  66.     if (struct_debug & (DBG_NEWOBJECT))
  67.     printf("Struct_NewObject( %s, ptr = %p, size = %d )\n",
  68.     Struct_TypeName(type), dataptr, size );
  69. #endif
  70.  
  71.     len = sizeof(Struct_Object);
  72.     if (size == 0)
  73.     size = type->size;
  74.     /*  If dataptr is null, allocate the data and the end of
  75.      *  of the object structure.  */
  76.     if (dataptr == NULL)
  77.     len += size;
  78.  
  79.     if ((object = (Struct_Object *)ckalloc(len)) == NULL) {
  80.     return NULL;
  81.     }
  82.     memset( (char *)object, 0x00, len );
  83. #ifdef STRUCT_MAGIC
  84.     object->magic = STRUCT_MAGIC_OBJECT;
  85. #endif
  86.     if (dataptr == NULL)
  87.     dataptr = (object + 1);
  88.  
  89.     object->data = dataptr;
  90.     object->size = size;
  91.     Struct_AttachType(type);
  92.     object->type = type;
  93.  
  94. #ifdef DEBUG
  95.     if (struct_debug & (DBG_NEWOBJECT))
  96.     printf("Struct_NewObject() = %s\n", Struct_ObjectName(object,1) );
  97. #endif
  98.     return object;
  99. }
  100.  
  101.  
  102. /*
  103.  * Create a new object
  104.  *
  105.  * usage : struct_new object|#auto type ?existingobject?
  106.  *
  107.  */
  108. int
  109. Struct_NewCmd(cdata, interp, argc, argv)
  110.   ClientData cdata;                   /* Client Data */
  111.   Tcl_Interp *interp;                 /* Current interpreter. */
  112.   int argc;                           /* Number of arguments. */
  113.   char **argv;                        /* Argument strings. */
  114. {
  115.     Struct_Object  *objptr;
  116.     Struct_TypeDef *type;
  117.     char *name;
  118.     Struct_Object oldobj;
  119.   
  120.     if (cdata==NULL) {
  121.     Tcl_AppendResult(interp, "Called Struct_NewCmd with NULL client data",NULL);
  122.     return TCL_ERROR;
  123.     }
  124.  
  125.     Struct_PkgInfo(cdata,si_cmdCount) += 1;
  126.     if (argc<3 || argc>4) {
  127.     Tcl_AppendResult(interp, "wrong # args: should be \"", argv[0],
  128.         " object|#auto type ?oldobject?\"", (char *) NULL);
  129.     return TCL_ERROR;
  130.     }
  131. #ifdef DEBUG
  132.     if (struct_debug & (DBG_COMMAND)) Struct_PrintCommand(argc,argv);
  133. #endif
  134.     name = (strcmp(argv[1],"#auto") == 0) ?
  135.     (char *)Struct_GenerateName(argv[2]) : argv[1];
  136.  
  137.     /* check object is not already defined (like in GetObject, but reversed
  138.        error condition */
  139.     if (STRUCT_GETOBJECT(interp,name)) {
  140.     Tcl_AppendResult(interp,"\"",name,"\" is already an object",NULL);
  141.     return TCL_ERROR;
  142.     }
  143.  
  144.     /* The type must be defined. */
  145.     if ((type = Struct_LookupType(cdata,interp,argv[2])) == NULL)
  146.     return TCL_ERROR;
  147.  
  148.     /* The type has to have a known size, so it cannot have a variable
  149.      * length type if we need to create it.  If the object already
  150.      * exists then we can get away with a variable length type.
  151.      */
  152.     if (argc < 4) {
  153.     oldobj.data = NULL;
  154.     oldobj.size = 0;
  155.     if (type->flags & STRUCT_FLAG_VARLEN) {
  156.         Tcl_AppendResult(interp,"\"",argv[2],"\" is a variable length type",NULL);
  157.         return TCL_ERROR;
  158.     }
  159.     } else if (Struct_GetObject(interp,argv[3],&oldobj) != TCL_OK) {
  160.     Struct_ReleaseType(type);
  161.     return TCL_ERROR;
  162.     } else if (type->size > oldobj.size) {
  163.     Tcl_AppendResult(interp,"\"",argv[2],"\" is too small",NULL);
  164.     return TCL_ERROR;
  165.     } else if ( (type->flags & STRUCT_FLAG_VARLEN) &&
  166.         !(oldobj.type->flags & STRUCT_FLAG_VARLEN) ) {
  167.     /* Instantiate type to correct length */
  168.     Struct_TypeDef *vartype;
  169. #ifdef DEBUG
  170.         if (struct_debug & (DBG_VARLEN))
  171.     printf("Struct_NewCmd: calculating how to instantiate %s into %d bytes\n",
  172.         Struct_TypeName(type), oldobj.size );
  173. #endif
  174.     for (vartype = type; vartype->flags & STRUCT_FLAG_IS_STRUCT; ) {
  175. #ifdef DEBUG
  176.         if (struct_debug & (DBG_VARLEN))
  177.         printf("Struct_NewCmd: following %s\n",Struct_TypeName(vartype));
  178. #endif
  179.         vartype = vartype->u.s.struct_def[vartype->u.s.num_elements -1].type;
  180.     }
  181.     type = Struct_InstantiateType(cdata,interp,NULL,type,
  182.         (oldobj.size - type->size) / vartype->u.a.array_elem->size );
  183.     }
  184.  
  185.     /*  Allocate the object. */
  186.     objptr = Struct_NewObject(type,oldobj.data,oldobj.size);
  187.     Struct_ReleaseType(type);
  188.     if (objptr == NULL) {
  189.     Tcl_SetResult(interp,"Can't allocate object!",TCL_STATIC);
  190.     return TCL_ERROR;
  191.     }
  192.  
  193.     /* Create the array and attach our trace to control element access */
  194.     if (Tcl_SetVar2(interp,name,"_type_",argv[2],TCL_LEAVE_ERR_MSG)==NULL)
  195.         return TCL_ERROR;
  196.     Tcl_TraceVar2(interp,name,NULL,
  197.         TCL_TRACE_READS|TCL_TRACE_WRITES|TCL_TRACE_UNSETS,
  198.         Struct_MainTraceProc,objptr);
  199.  
  200.     Tcl_SetResult(interp,name,TCL_VOLATILE);
  201.     return TCL_OK;
  202. }
  203.  
  204. /*******************************************************************/
  205. /*
  206.  * Delete Object
  207.  *
  208.  */
  209. void
  210. Struct_DeleteObject(object) 
  211.   Struct_Object *object;
  212. {
  213.     if (object != NULL) {
  214.     Struct_CheckObject(object,"DeleteObject");
  215. #ifdef DEBUG
  216.     if (struct_debug & (DBG_NEWOBJECT))
  217.     printf("Struct_DeleteObject( %s )\n", Struct_ObjectName(object,1) );
  218. #endif
  219.     Struct_ReleaseType(object->type);
  220.     ckfree((char *)object);
  221.     }
  222. }
  223.  
  224.